Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue33/undo/Undo.pas

Pascal/Delphi Source File | 1998-02-20 | 8.6 KB | 352 lines

unit Undo;

{ This unit contains the base classes for a command pattern-based
  undo Stack.

  Author : Warren Kovach ([e-mail])
  Published in The Delphi Magazine }

interface

uses
  Sysutils, Classes, Forms, Menus;

{$IFDEF WIN32}
  {$IFDEF VER90}
const
  {$ELSE}
resourcestring
  {$ENDIF}
{$ELSE}
const
{$ENDIF}
  sUndoDescr = 'Undo last action';
  sShortUndoDescr = 'Undo last';
  sRedoDescr = 'Redo last action';
  sShortRedoDescr = 'Redo last';
  sUndoMenu = '&Undo';
  sRedoMenu = '&Redo';
  sNoUndoDescr = 'Command not available; nothing to undo.';
  sNoRedoDescr = 'Command not available; nothing to redo.';
  sStackFull = 'Undo Stack is full; only the last %d actions can be undone';

type
  EHiddenProc = class(Exception);

  TStackStatus = (ssFull, ssNotFull);

  { this is an ancestral type; different forms can inherit
    this and modify it to meet needs of data on that form }
  TUndoItem = class(TObject)
    protected
      function GetUndoDescription : string; virtual;
      function GetShortUndoDescription : string; virtual;
      function GetRedoDescription : string; virtual;
      function GetShortRedoDescription : string; virtual;
      function GetUndoMenuText : string; virtual;
      function GetRedoMenuText : string; virtual;
    public
      procedure DoCommand; virtual; abstract;
      procedure Undo; virtual; abstract;
      procedure Redo; virtual; abstract;
      property UndoDescription : string read GetUndoDescription;
      property ShortUndoDescription : string read GetShortUndoDescription;
      property RedoDescription : string read GetRedoDescription;
      property ShortRedoDescription : string read GetShortRedoDescription;
      property UndoMenuText : string read GetUndoMenuText;
      property RedoMenuText : string read GetRedoMenuText;
  end;

  TUndoStack = class(TList)
  private
    FMaxItems : integer;
    procedure HiddenProcExcept;
    procedure SetMaxItems(AMaxItems : integer);
    function GetCurrentItem : TUndoItem;
    function GetCurrentRedoItem : TUndoItem;
    function CanUndo : boolean;
    function CanRedo : boolean;
    procedure UndoClick(Sender: TObject);
    procedure RedoClick(Sender: TObject);
  protected
    CurrentUndo : integer;
  public
    constructor Create(AMaxItems:integer);
    destructor Destroy; override;
    procedure Clear;
    procedure DeleteAndFree(Item : integer);
    function  Submit(Item:TUndoItem) : TStackStatus;
    procedure Undo(Num : integer);
    procedure Redo(Num : integer);
    procedure RemoveLastItem;
    procedure SetUndoMenuItems(var UndoItem,RedoItem : TMenuItem);
    property  MaxItems : integer read FMaxItems write SetMaxItems;
    property  CurrentItem : TUndoItem read GetCurrentItem;
    property  CurrentRedoItem : TUndoItem read GetCurrentRedoItem;
    { disable other access methods }
    procedure Delete(Index: Integer);
    function  Add(Item : Pointer): Integer;
    procedure Insert(Index: Integer; const S: string);
    procedure Move(CurIndex, NewIndex: Integer);
    procedure Exchange(Index1, Index2: Integer);
  end;

  TUndoForm = class(TForm)
    public
      UndoStack : TUndoStack;
      constructor Create(AOwner : TComponent); override;
      destructor Destroy; override;
  end;

procedure DisableUndoMenus(UndoItem,RedoItem : TMenuItem);

implementation

function TUndoItem.GetUndoDescription : string;
begin
  Result := sUndoDescr;
end;

function TUndoItem.GetShortUndoDescription : string;
begin
  Result := sShortUndoDescr;
end;

function TUndoItem.GetRedoDescription : string;
begin
  Result := sRedoDescr;
end;

function TUndoItem.GetShortRedoDescription : string;
begin
  Result := sShortRedoDescr;
end;

function TUndoItem.GetUndoMenuText : string;
begin
  Result := sUndoMenu;
end;

function TUndoItem.GetRedoMenuText : string;
begin
  Result := sRedoMenu;
end;
{ -------------------------------------------------- }
constructor TUndoStack.Create(AMaxItems : integer);
begin
  inherited Create;
  FMaxItems := AMaxItems;
  if FMaxItems > MaxListSize then
    FMaxItems := MaxListSize;
  CurrentUndo := -1;
end;

destructor TUndoStack.Destroy;
begin
  Clear;
  inherited Destroy;
end;

procedure TUndoStack.Clear;
var
  i: Integer;
begin
  for i := pred(Count) downto 0 do DeleteAndFree(i);
  inherited Clear;
end;

procedure TUndoStack.DeleteAndFree(Item : integer);
begin
  TUndoItem(Items[Item]).Free;
  inherited Delete(Item);
end;

procedure TUndoStack.SetMaxItems(AMaxItems : integer);
var
  i : integer;
begin
  { delete oldest entries if list is shrinking }
  if AMaxItems < FMaxItems then
    for i := 0 to pred(FMaxItems - AMaxItems) do
      DeleteAndFree(0);
  FMaxItems := AMaxItems;
  CurrentUndo := pred(Count);
end;

function TUndoStack.GetCurrentItem : TUndoItem;
begin
  if CanUndo then
    Result := Items[CurrentUndo]
  else
    Result := nil;
end;

function TUndoStack.GetCurrentRedoItem : TUndoItem;
begin
  if CanRedo then
    Result := Items[succ(CurrentUndo)]
  else
    Result := nil;
end;

function TUndoStack.CanUndo : boolean;
begin
  Result := CurrentUndo >= 0;
end;

function TUndoStack.CanRedo : boolean;
begin
  Result := (Count > 0) and (CurrentUndo < pred(Count));
end;

function TUndoStack.Submit(Item:TUndoItem) : TStackStatus;
var
  i : integer;
begin
  Item.DoCommand;
  { Check to see if we have undone one or more commands }
  if CanRedo then
    { if so then get rid of ones in Redo list (those above the pointer) }
    for i := pred(Count) downto succ(CurrentUndo) do
      DeleteAndFree(i);
  { check if stack is full; if so, pop off oldest command }
  if Count >= MaxItems then begin
    DeleteAndFree(0);
    Result := ssFull;
  end
  else Result := ssNotFull;
  inherited Add(Item);
  { point at top of stack (the size of which may have been modified
    above; can't just inc(CurrentUndo) }
  CurrentUndo := pred(Count);
end;

procedure TUndoStack.Undo(Num : integer);
var
  i : integer;
begin
  if CanUndo then
    for i := 1 to Num do begin
      CurrentItem.Undo;
      dec(CurrentUndo);
      if not CanUndo then exit;
    end;
end;

procedure TUndoStack.Redo(Num : integer);
var
  i : integer;
begin
  for i := 1 to Num do begin
    if CanRedo then begin
      CurrentRedoItem.Redo;
      inc(CurrentUndo);
    end;
  end;
end;

procedure TUndoStack.RemoveLastItem;
begin
  if Count > 0 then begin
    DeleteAndFree(pred(Count));
    dec(CurrentUndo);
  end;
end;

procedure TUndoStack.UndoClick(Sender: TObject);
begin
  Undo(1);
end;

procedure TUndoStack.RedoClick(Sender: TObject);
begin
  Redo(1);
end;

procedure TUndoStack.SetUndoMenuItems(var UndoItem,RedoItem : TMenuItem);
begin
  if CanRedo then begin
    RedoItem.Caption := CurrentRedoItem.RedoMenuText;
    RedoItem.Enabled := true;
    RedoItem.Hint := CurrentRedoItem.RedoDescription;
    RedoItem.OnClick := RedoClick;
  end
  else begin
    DisableUndoMenus(nil,RedoItem);
  end;
  if CurrentItem <> nil then begin
    UndoItem.Caption := CurrentItem.UndoMenuText;
    UndoItem.Enabled := true;
    UndoItem.Hint := CurrentItem.UndoDescription;
    UndoItem.OnClick := UndoClick;
  end
  else
    DisableUndoMenus(UndoItem,nil);
end;


{ disable other access methods }
procedure TUndoStack.HiddenProcExcept;
begin
  Raise EHiddenProc.Create('Error - access to stack only allowed through Submit and Clear');
end;

function TUndoStack.Add(Item : Pointer): Integer;
begin
  HiddenProcExcept;
end;

procedure TUndoStack.Delete(Index: Integer);
begin
  HiddenProcExcept;
end;

procedure TUndoStack.Insert(Index: Integer; const S: string);
begin
  HiddenProcExcept;
end;

procedure TUndoStack.Move(CurIndex, NewIndex: Integer);
begin
  HiddenProcExcept;
end;

procedure TUndoStack.Exchange(Index1, Index2: Integer);
begin
  HiddenProcExcept;
end;

{ ----------------------------------------------- }

constructor TUndoForm.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);
  UndoStack := TUndoStack.Create(100);
end;

destructor TUndoForm.Destroy;
begin
  UndoStack.Free;
  inherited destroy;
end;

{ ----------------------------------------------- }

procedure DisableUndoMenus(UndoItem,RedoItem:TMenuItem);
begin
  if UndoItem <> nil then begin
    UndoItem.Caption := sUndoMenu;
    UndoItem.Enabled := false;
    UndoItem.Hint := sNoUndoDescr;
    UndoItem.OnClick := nil;
  end;
  if RedoItem <> nil then begin
    RedoItem.Caption := sRedoMenu;
    RedoItem.Enabled := false;
    RedoItem.Hint := sNoRedoDescr;
    RedoItem.OnClick := nil;
  end;
end;

end.